C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C ----------------------------------------------------------------------
C
C       L O A D T S   -   Establish statement type directory entry
C
 
        SUBROUTINE LOADTS(IEXECA,ICODEA)
        INTEGER IEXECA,ICODEA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
 
        CHARACTER ICHARL
        INTEGER NCHARL,L
 
C Save number of type and position in table
        NTYPEG = NTYPEG + 1
        ICODEA = NTYPEG
        KEXECG(NTYPEG) = IEXECA
 
        END
C ----------------------------------------------------------------------
C
C       N F I N D F   -   Locate a mnemonic in a mnemonic dictionary.
C
 
        INTEGER FUNCTION NFINDF(NAMEA,IARYA,IDIMA)
        CHARACTER*6 IARYA(*),NAMEA
        INTEGER IDIMA
 
        INTEGER L
 
        NFINDF=0
        DO 100 L=1,IDIMA
            IF (NAMEA.EQ.IARYA(L)) THEN
                NFINDF = L
                RETURN
            END IF
  100   CONTINUE
 
        END
C ----------------------------------------------------------------------
C
C       N S A V E S   -   Ensure a name is saved in a dictionary,
C                         returning its location in the dictionary.
C
 
        SUBROUTINE NSAVES(NAMEA,IARYA,NUMA,MAXA,LOCA)
        CHARACTER*6 IARYA(*),NAMEA
        INTEGER NUMA,MAXA,LOCA
 
        INTEGER LOCL
 
        INTEGER NFINDF
 
C Is mnemonic already in dictionary?
        LOCL = NFINDF(NAMEA,IARYA,NUMA)
        IF (LOCL.NE.0) THEN
C Mnemonic in dictionary
            LOCA = LOCL
        ELSE
C Mnemonic not in dictionary
            IF (NUMA.LT.MAXA) THEN
C Add to dictionary
                NUMA = NUMA + 1
                IARYA(NUMA) = NAMEA
                LOCA = NUMA
            ELSE
C Dictionary overflow
                LOCA = 0
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       O U T S   -   Control output of normal statement annotation
C                     and instrumentation
C
 
        SUBROUTINE OUTS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
 
        IF (KEXECG(ITYPEG).EQ.1) THEN
C This statement is executable
            IF (LABFLG.EQ.2 .AND. SEGMTG .AND. ITYPEG.NE.KCONTG) THEN
C This statement ends an active DO-loop
                CALL OUTDOS
                CALL SENDTK(2,NTOKSS)
                CALL SEND
                CALL OUTANS(NMSEG)
            ELSE
C This statement does not end a do-loop, ends an inactive DO-loop,
C or is a 'CONTINUE' statement which ends an active DO-loop.
                IF (SEGMTG) THEN
C This statement starts a segment - output segment instrumentation.
                    CALL OUTSGS(NMSEG)
C Output annotation
                    CALL OUTANS(NMSEG)
C If not a CONTINUE, output instrumented statement ...
C But remove label first (if any)
                    IF (LABFLG.NE.0) CALL UNLABL
                    IF (ITYPEG.NE.KCONTG) CALL INSOUT
                ELSE
C Executable statement, but no segment required
                    CALL OUTANS(0)
                    CALL INSOUT
                END IF
            END IF
        ELSE
C Non-executable statement
            IF (LTYPEG.EQ.KENDG .AND. SEGMTG) THEN
C First segment of routine
                CALL OUTANS(NMSEG)
            ELSE
C Not first segment of routine
                CALL OUTANS(0)
            END IF
            CALL INSOUT
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       O U T A N S   -   Output statement to annotated listing
C
 
        SUBROUTINE OUTANS(NSEGA)
        INTEGER NSEGA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
 
        INTEGER I
 
        CHARACTER*5 SEGNUM
 
C Convert segment number to characters
        IF (NSEGA.NE.0) THEN
            WRITE(SEGNUM,9000) NSEGA
            CALL WRITOK(TCMMNT,'*$AN$'//SEGNUM)
        END IF
        DO 100 I=1,NTOKSS
 100        CALL ZTOKWR(TOKTYP(I),TOKLEN(I),ISTTXT(ISTPTR(I)),
     +                  TKODES)
 
9000    FORMAT(SS,I5)
        END
C ----------------------------------------------------------------------
C
C       O U T D O S   -   Output segment for DO-loop ending statement
C
 
        SUBROUTINE OUTDOS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  ROUTINE INSTRUMENTATION FLAGS
      COMMON / INSTC   /    INST1G,      INST2G,      INST3G
 
        INTEGER INST1G,INST2G,INST3G
 
        SAVE /INSTC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        IFDOG = .TRUE.
        INST3G = 1
        CALL SENDTK(1,1)
        CALL SENDCH('IF(L'//VNAMEG//'(.TRUE.,')
        CALL SENDI(NMSEG)
        CALL SENDCH(',0))')
 
        END
C ----------------------------------------------------------------------
C
C       O U T I F S   -   Output annotated IF statements
C
 
        SUBROUTINE OUTIFS(ISEGA,JSEGA)
        INTEGER ISEGA,JSEGA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        CHARACTER*5 ISEG,JSEG
 
        IF (ISEGA.NE.0) THEN
            WRITE(ISEG,9000) ISEGA
        ELSE
            ISEG=' '
        END IF
        WRITE(JSEG,9000) JSEGA
        CALL WRITOK(TCMMNT,'*$AN$'//ISEG//'      '//JSEG)
        CALL OUTANS(0)
 
9000    FORMAT(SS,I5)
        END
C ----------------------------------------------------------------------
C
C       O U T S G S   -   Output a normal segment
C
 
        SUBROUTINE OUTSGS(NMSEGA)
        INTEGER NMSEGA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        IF (.NOT.BLKDTG) THEN
            IF (TOKTYP(1).EQ.TDCNST) THEN
                CALL SENDTK(1,1)
            ELSE
                CALL SENDCH('      ')
            END IF
            IF (TRACEG) THEN
                CALL SENDCH('CALL T'//VNAMEG//'(')
                CALL SENDI(NMSEGA)
                CALL SENDCH(')')
            ELSE
                CALL SENDCH('I'//VNAMEG//'(')
                CALL SENDI(NMSEGA)
                CALL SENDCH(')=I'//VNAMEG//'(')
                CALL SENDI(NMSEGA)
                CALL SENDCH(')+1')
            END IF
            CALL SEND
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       P A I F S   -   Process arithmetic IF statements
C
 
        SUBROUTINE PAIFS(NTOKA,NTOK2A)
        INTEGER NTOKA,NTOK2A
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  ROUTINE INSTRUMENTATION FLAGS
      COMMON / INSTC   /    INST1G,      INST2G,      INST3G
 
        INTEGER INST1G,INST2G,INST3G
 
        SAVE /INSTC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        CHARACTER*5 SEGNUM(4)
 
        ARITHG = .TRUE.
        INST1G = 1
C Output segment for test portion, if required
        IF (SEGMTG) THEN
            IF (LABFLG.NE.2) CALL OUTSGS(NMSEG)
            WRITE(SEGNUM(1),9000) NMSEG
        ELSE
            SEGNUM(1)=' '
        END IF
C Output summary file records for prior segment and first two branch
C segments. Ensure 'IF' counted with segment prior to first branch
        ISCNTG(ITYPEG) = ISCNTG(ITYPEG) + 1
        SEGMTG = .FALSE.
        CALL SEGMTS(.TRUE.)
        SEGMTG = .FALSE.
        CALL SEGMTS(.TRUE.)
        SEGMTG = .FALSE.
        CALL SEGMTS(.TRUE.)
        ISCNTG(ITYPEG) = ISCNTG(ITYPEG) - 1
C Build arithmetic 'IF' in buffer
        CALL PAIF2S(NTOKA,NTOK2A)
C Output instrumented statement
        CALL SEND
C Output annotated statement
        WRITE(SEGNUM(2),9000) NMSEG-2
        WRITE(SEGNUM(3),9000) NMSEG-1
        WRITE(SEGNUM(4),9000) NMSEG
        CALL WRITOK(TCMMNT,'*$AN$'//SEGNUM(1)//'      '//SEGNUM(2)//
     +              ' '//SEGNUM(3)//' '//SEGNUM(4))
        CALL OUTANS(0)
 
9000    FORMAT(SS,I5)
        END
C ----------------------------------------------------------------------
C
C       P A I F 2 S   -   Build arithmetic 'IF' in buffer
C
 
        SUBROUTINE PAIF2S(NTOKA,NTOK2A)
        INTEGER NTOKA,NTOK2A
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        INTEGER L
 
C Pack first part of arithmetic 'IF'and set up label field
        IF (LABFLG.EQ.2) THEN
            CALL SENDTK(1,1)
        ELSE
            CALL SENDCH('      ')
        END IF
        CALL SENDCH('IF(A'//VNAMEG//'(0.D0+')
C Pack computational portion of 'IF'
        CALL SENDTK(NTOKA,NTOK2A)
C Pack constants
        CALL SENDCH(',')
        CALL SENDI(NMSEG-2)
        CALL SENDCH(')')
C Pack branch portion of 'IF'
        CALL SENDTK(NTOK2A,NTOKSS)
 
        END
C ----------------------------------------------------------------------
C
C       P A S S 1 S   -   Determine segmentation and instrumentation
C                         of original source code. Input original
C                         source code and output statement type summary
C                         file, annotated listing and a temporary
C                         instrumented program file.
C
 
        SUBROUTINE PASS1S
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
 
C Pass 1 input loop:
C Read an entire statement
  100   CALL READSS
        IF (.NOT.IEOFG) THEN
            IF (ISTMG(1).EQ.'*') THEN
C Assertion statement being processed
                CALL ASSRTS
            ELSE
C Normal statement being processed
                NBUFFG = 0
                LTYPEG = ITYPEG
                CALL TYPES(1,ITYPEG,NTOKG,NTOK2G)
                IF (ITYPEG .EQ. KLIFG)
     +              CALL TYPES(NTOK2G+1,IFTYPG,NTOK3G,NTOK4G)
                CALL PROCES
                CALL COUNTS(ITYPEG)
C Start segment after certain statements
                IF (ITYPEG.EQ.KCGOG .OR. ITYPEG.EQ.KDOG .OR.
     +              ITYPEG.EQ.KBIFG .OR. ITYPEG.EQ.KAIFG .OR.
     +              ITYPEG.EQ.KLIFG .OR. ITYPEG.EQ.KELSFG .OR.
     +              LABFLG.EQ.2) THEN
                    SEGMTG = .FALSE.
                    CALL SEGMTS(.TRUE.)
                END IF
            END IF
            IF (.NOT.IEOFG) GOTO 100
        END IF
        CALL DMPCMS
        IABEG(NRTNG+1) = NMASRG + 1
        ISBEG(NRTNG+1) = NMSEG + 1
C Print message if no 'STOP' found
        IF (.NOT.STOPG) CALL ERRORS(9)
C Check for abnormal source program end
        IF (ITYPEG.NE.KENDG) THEN
            CALL RDONES
            CALL ERRORS(20)
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       P A S S 2 S  - Add instrumentation at program level, including
C                      common blocks to user routines and extra routines
C                      required for monitoring and output functions.
C
 
        SUBROUTINE PASS2S
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Filenames
        COMMON/ANFNAM/IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
        CHARACTER*81 IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
        SAVE /ANFNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
 
        INTEGER CLEN,IRTNL
 
        CHARACTER*72 CARD
 
        INTEGER ZGETLN
        EXTERNAL SEEK,ZGETLN
 
        CALL SEEK(0,IODSCR)
        IF (NMSEG.GT.0 .AND. NRTNG.GT.0) THEN
            IF (ASSRTG .AND. NMASRG.EQ.0) ASSRTG=.FALSE.
C Move instrumentation from scratch to final file
 100        CLEN=ZGETLN(CARD,IODSCR)
            IF (CLEN.EQ.-100) GOTO 110
            IF (CLEN.LT.5) CARD(CLEN+1:5)=' '
            IF (CARD(1:2).EQ.'$ ') THEN
C Instrumentation marker found. Insert required common
C blocks and add special function type declarations,
C if routine flags indicate functions used.
                CALL WCOMNS
                READ(CARD(3:5),9000) IRTNL
                IF (ARITHG .AND. INSTG(IRTNL).GE.4)
     +            CALL OUTMSG('      DOUBLE PRECISION A'//VNAMEG,IODINS)
                IF (CGOTOG .AND. MOD(INSTG(IRTNL),4).GE.2)
     +            CALL OUTMSG('      INTEGER K'//VNAMEG,IODINS)
                IF (IFDOG .AND. MOD(INSTG(IRTNL),2).EQ.1)
     +            CALL OUTMSG('      LOGICAL L'//VNAMEG,IODINS)
            ELSE
C Output this statement
                CALL OUTMSG(CARD(1:CLEN),IODINS)
            END IF
            GOTO 100
C Output additional instrumenting routines.
C Arithmetic IF function
  110       IF (ARITHG) CALL WARTHS
C BLOCK DATA
            CALL WBLOKS
C Computed GOTO function
            IF (CGOTOG) CALL WGOTOS
C Logical IF function
            IF (IFDOG) CALL WIFDOS
C Assertion monitoring routine
            IF (ASSRTG) CALL WASRTS
C History input/output routines
            IF (HISTG) THEN
                CALL WHINS
                CALL WHOUTS
            ELSE IF (RUNFN.NE.' ' .OR. ITRUNG.NE.0) THEN
                CALL WHOUTS
            END IF
C Line count routine
            CALL WLINES
C Wrapup control routine
            CALL WRAPS
C Assertion/segment report routine
            CALL WREPTS
C Trace input/output routines
            IF (TRACEG) THEN
                CALL WTBUFS
                CALL WTINS
                CALL WTOUTS
            END IF
        END IF
 
9000    FORMAT(BN,I3)
        END
